home *** CD-ROM | disk | FTP | other *** search
- unit Ccicnntp;
-
- interface
-
- uses
- SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
- Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, Menus, FileCtrl, CCWSock, CCICCInf,
- CCICCPrf, IniFiles, Gauges , CCUUCode, CCiccfrm;
- type
- { Component to hold NNTP handling capabilities }
- TNNTPComponent = class( TWinControl )
- public
- NNTPCommandInProgress ,
- Connection_Established : Boolean;
- Socket1 : TCCSocket;
- constructor Create( AOwner : TComponent ); override;
- destructor Destroy; override;
- function EstablishConnection( PCRPointer : PConnectionsRecord ) : Boolean;
- function Disconnect : Boolean;
- function DoCStyleFormat( TheText : string;
- const TheArguments : array of const ) : String;
- procedure UpdateGauge( BytesFinished , TotalToHandle : longint );
- procedure AddProgressText( WhatText : String );
- procedure ShowProgressText( WhatText : String );
- procedure ShowProgressErrorText( WhatText : String );
- function GetNNTPServerResponse( var ResponseString : String ) : integer;
- procedure NNTPSocketsErrorOccurred( Sender : TObject;
- ErrorCode : Integer;
- TheMessage : String );
- function PerformNNTPCommand(
- TheCommand : string;
- const TheArguments : array of const ) : Integer;
- function PerformBlindNNTPCommand( TheCommand : string ) : Integer;
- function PerformNNTPExtendedCommand(
- TheCommand : string;
- const TheArguments : array of const ) : Integer;
- function GetNNTPServerExtendedResponse( ResponseString : PChar ) : integer;
- function GetNextSDItem( WorkingString : String;
- var TheIndex : Integer ) : String;
- function GetListOfAvailableNewsGroups : Boolean;
- function PurgeReadSentArticleListings( TheNGRecord : PNewsGroupRecord ): Boolean;
- procedure ParseNewsGroupListing( TheListing : String;
- var GroupName : String;
- var LowCurrent : Longint;
- var HighCurrent : Longint;
- var Postable : Boolean );
- function SetCurrentNewsGroup( TheNGRecord : PNewsGroupRecord;
- DoUpdate : Boolean ) : Boolean;
- function CheckForNewNews( TheNGRecord : PNewsGroupRecord ) : Boolean;
- function CheckAllNewNews : Boolean;
- function SetNewsHeaders( TheMemo : TMemo ;
- GroupNumber : Integer ) : Boolean;
- function SetFUNewsHeaders( TheMemo : TMemo ;
- GroupNumber ,
- ArticleNumber : Integer ) : Boolean;
- procedure ParseArticleListing( TheListing : String;
- var TotalAvailable : Longint;
- var LowestAvailable : Longint;
- var HighestAvailable : Longint );
- function GetArticleHeader( TheNumber : Longint;
- TheReturnList : TStringList ) : Boolean;
- function GetAllArticleHeaders( TheNGRecord : PNewsGroupRecord ) : Boolean;
- function DownloadArticleListing( TheNumber : Longint;
- TheFileName : String ) : Boolean;
- function DownloadAllArticleListings( TheNGRecord : PNewsGroupRecord ) : Boolean;
- function UploadArticleListing( TheNGARecord : PNewsGroupArticleRecord ) : Boolean;
- function UploadAllArticleListings( TheNGRecord : PNewsGroupRecord ) : Boolean;
- function GetHeaderSubject( HList : TStringList ) : String;
- function GetHeaderSender( HList : TStringList ) : String;
- function DownloadAllMarkedArticleListings( TheNGRecord : PNewsGroupRecord;
- TheListbox : TListbox ) : Boolean;
- end;
-
- implementation
-
- { This function calls an extended response NNTP command routine }
- function TNNTPComponent.PerformNNTPExtendedCommand(
- TheCommand : string;
- const TheArguments : array of const ) : Integer;
- var TheBuffer : string; { Text buffer }
- begin
- { If command in progress send back -1 error }
- if NNTPCommandInProgress then
- begin
- Result := -1;
- exit;
- end;
- { Set status variable }
- NNTPCommandInProgress := True;
- { Set global error code }
- GlobalErrorCode := 0;
- { Format output string }
- TheBuffer := Format( TheCommand , TheArguments );
- { Preset failure code }
- Result := TCPIP_STATUS_FATAL_ERROR;
- { If invalid socket or no connection abort }
- if ( Socket1.TheSocket = INVALID_SOCKET ) or not Connection_Established then
- exit;
- { Send the buffer plus EOL chars }
- Socket1.StringData := TheBuffer + #13#10;
- { if abort due to timeout or other error exit }
- if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
- { Otherwise return preliminary code }
- Result := TCPIP_STATUS_PRELIMINARY;
- end;
-
- { This function gets an extended period-ended multiline response from the server }
- function TNNTPComponent.GetNNTPServerExtendedResponse( ResponseString : PChar ) : integer;
- var
- { Assume ResponseString already allocated as 0..513 }
- { Pointer to the response string }
- TheBuffer ,
- BufferPointer : array[0..255] of char;
- HolderBuffer : array[0..513] of char;
- { Character to check for response code }
- ResponseChar : char;
- { Pointers into returned string }
- TheIndex ,
- TheLength : integer;
- { Control variable }
- LeftoversInPan ,
- Finished : Boolean;
- BufferString : String;
- begin
- { Preset fatal error }
- Result := TCPIP_STATUS_FATAL_ERROR;
- { Start loop control }
- LeftoversInPan := false;
- Finished := false;
- StrCopy( HolderBuffer , '' );
- repeat
- { Do a peek }
- BufferString := Socket1.PeekData;
- { If timeout or other error exit }
- if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
- { Find end of line character }
- TheIndex := Pos( #10 , BufferString );
- if TheIndex = 0 then
- begin
- TheIndex := Pos( #13 , BufferString );
- if TheIndex = 0 then
- begin
- TheIndex := Pos( #0 , BufferString );
- if TheIndex = 0 then
- begin
- TheIndex := Length( BufferString );
- LeftoversInPan := True;
- StrPCopy( TheBuffer , BufferString );
- StrCat( HolderBuffer , TheBuffer );
- LeftoversOnTable := false;
- end;
- end;
- end;
- { If an end of line then process the line }
- if TheIndex > 0 then
- begin
- { Get length of string }
- TheLength := TheIndex;
- { Receive actual data }
- Socket1.CCSockReceive( Socket1.TheSocket ,
- @BufferPointer[ 0 ] ,
- TheLength );
- { Abort if timeout or error }
- if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
- { Put in the length byte }
- BufferPointer[ TheLength ] := Chr( 0 );
- if LeftOversOnTable then
- begin
- LeftOversOnTable := false;
- StrCopy( ResponseString , HolderBuffer );
- StrCat( ResponseString , BufferPointer );
- end
- else
- begin
- if not LeftoversInPan then StrCopy( ResponseString , BufferPointer );
- end;
- if LeftoversInPan then
- begin
- LeftoversInPan := false;
- LeftoversOnTable := true;
- end
- else
- begin
- ResponseChar := ResponseString[ 0 ];
- if (( ResponseChar = '.' ) and ( StrLen( ResponseString ) <= 3 )) then
- begin
- Finished := true;
- Result := TCPIP_STATUS_COMPLETED;
- end
- else
- begin
- if ResponseChar = '.' then ResponseString[ 0 ] := ' ';
- Finished := true;
- Result := TCPIP_STATUS_PRELIMINARY;
- end;
- end;
- end;
- until ( Finished and ( not LeftoversOnTable ));
- StrLCopy( ResponseString , ResponseString , StrLen( ResponseString ) - 2 );
- end;
-
- { This function moves along a string from an index, getting the next }
- { string delimited item or last one on string. }
- function TNNTPComponent.GetNextSDItem( WorkingString : String;
- var TheIndex : Integer ) : String;
- var HoldingString : String;
- begin
- HoldingString := Copy( WorkingString , TheIndex + 1 , 255 );
- TheIndex := Pos( ' ' , HoldingString );
- if TheIndex = 0 then
- begin
- Result := HoldingString;
- end
- else
- begin
- HoldingString := Copy( HoldingString , 1 , TheIndex - 1 );
- Result := HoldingString;
- end;
- end;
-
- { This is the first true "network" function; it sends a LIST command, eats }
- { a single 215 response and then grabs PChars of data from the server till }
- { It returns a period character. The returned line is sent to a NEWSGRP }
- { file and a status update is send through. }
- function TNNTPComponent.GetListOfAvailableNewsGroups : Boolean;
- var TheReturnString : String; { Internal string holder }
- TheResult : Integer; { Internal int holder }
- HoldPChar ,
- TheHoldingPChar ,
- TheReturnPChar : PChar;
- TheNGFile : TextFile;
- D1 , D2 : Longint;
- D3 : Boolean;
- GroupString : String;
- TotalGroups : Longint;
- begin
- Result := false;
- TheReturnString :=
- DoCStyleFormat( 'LIST' ,
- [ nil ] );
- { Put result in progress and status line }
- AddProgressText( TheReturnString );
- ShowProgressText( TheReturnString );
- { Begin login sequence with user name }
- TheResult := PerformNNTPCommand( 'LIST', [ nil ] );
- if TheResult <> TCPIP_STATUS_PRELIMINARY then
- begin
- NNTPCommandInProgress := false;
- Result := false;
- exit;
- end;
- repeat
- TheResult := GetNNTPServerResponse( TheReturnString );
- { Put result in progress and status line }
- AddProgressText( TheReturnString );
- ShowProgressText( TheReturnString );
- until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
- NNTPCommandInProgress := false;
- if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
- begin
- { Do clever C formatting trick }
- TheReturnString :=
- DoCStyleFormat( 'LIST Failed!' ,
- [ nil ] );
- { Put result in progress and status line }
- AddProgressText( TheReturnString );
- ShowProgressErrorText( TheReturnString );
- { Signal error }
- Result := False;
- { leave }
- exit;
- end;
- try
- AssignFile( TheNGFile , NewsPath + '\NEWSGRP.TXT' );
- Rewrite( TheNGFile );
- except
- Socket1.OutOfBand := 'ABOR'+#13#10;
- repeat
- TheResult := GetNNTPServerResponse( TheReturnString );
- { Put result in progress and status line }
- AddProgressText( TheReturnString );
- ShowProgressText( TheReturnString );
- until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
- Result := false;
- exit;
- end;
- GetMem( TheReturnPChar , 514 );
- HoldPChar := TheReturnPChar;
- TotalGroups := 0;
- CCICInfoDlg.ListBox1.Clear;
- repeat
- Application.ProcessMessages;
- if GlobalAbortedFlag then exit;
- Inc(TotalGroups );
- TheResult := GetNNTPServerExtendedResponse( TheReturnPChar );
- if StrLen( TheReturnPChar ) > 255 then
- begin
- Getmem( TheHoldingPChar , 255 );
- while StrLen( TheReturnPChar ) > 255 do
- begin
- StrCopy( TheHoldingPChar , '' );
- StrMove( TheHoldingPChar , TheReturnPChar , 255 );
- TheReturnPChar := TheReturnPChar + 256;
- TheReturnString := StrPas( TheHoldingPChar );
- ParseNewsGroupListing( TheReturnString, GroupString, D1 , D2 , D3 );
- end;
- FreeMem( TheHoldingPChar , 255 );
- Writeln( TheNGFile , GroupString );
- CCICInfoDlg.ListBox1.Items.Add( GroupString );
- CCINetCCForm.Panel1.Caption := GroupString +
- '(' + IntToStr( TotalGroups ) + ')';
- end
- else
- begin
- TheReturnString := StrPas( TheReturnPChar );
- ParseNewsGroupListing( TheReturnString, GroupString, D1 , D2 , D3 );
- Writeln( TheNGFile , GroupString );
- CCICInfoDlg.ListBox1.Items.Add( GroupString );
- CCINetCCForm.Panel1.Caption := GroupString +
- '(' + IntToStr( TotalGroups ) + ')';
- end;
- until (( GlobalAbortedFlag ) or ( TheResult = TCPIP_STATUS_COMPLETED ));
- FreeMem( HoldPChar , 514 );
- CloseFile( TheNGFile );
- Result := true;
- CCINetCCForm.Panel1.Caption := 'Finished LIST!';
- end;
-
- { This method sets a news group and updates its internal data }
- function TNNTPComponent.CheckForNewNews( TheNGRecord : PNewsGroupRecord ) : Boolean;
- begin
- { Gee, that was easy! }
- Result := SetCurrentNewsGroup( TheNGRecord , true );
- end;
-
- { This method puts all the headers into the memo, getting the group name from gn }
- function TNNTPComponent.SetNewsHeaders( TheMemo : TMemo ;
- GroupNumber : Integer ) : Boolean;
- var TheNGRecord : PNewsGroupRecord;
- DateString , TimeString : String;
- begin
- TheMemo.Clear;
- TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ GroupNumber ] );
- TheMemo.Lines.Add( 'Newsgroups:' + TheNGRecord^.GRealName );
- TheMemo.Lines.Add( 'From:' );
- TheMemo.Lines.Add( 'Subject:');
- TheMemo.Lines.Add( 'Organization: CIUPKC Software' );
- TheMemo.Lines.Add( 'Reply-To:' );
- TheMemo.Lines.Add( 'X-Newsreader: CC Internet Command Center' );
- DateString := DateToStr( Date ) + ' ';
- TimeString := TimeToStr( Time );
- TheMemo.Lines.Add( 'Date: ' + DateString + TimeString );
- TheMemo.Lines.Add( '' );
- Result := true;
- end;
-
- { This function adds the text of an article to the current memo with > }
- function TNNTPComponent.SetFUNewsHeaders( TheMemo : TMemo ;
- GroupNumber ,
- ArticleNumber : Integer ) : Boolean;
- var WorkingList : TList;
- TheNGRecord : PNewsGroupRecord;
- TheNGARecord : PNewsGroupArticleRecord;
- Counter_1 : Integer;
- WorkingFileName : String;
- DateString , TimeString : String;
- begin
- TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ GroupNumber ] );
- WorkingList := TList( TheNGRecord^.GLTag );
- TheNGARecord := PNewsGroupArticleRecord( WorkingList.Items[ ArticleNumber ] );
- WorkingFileName := TheNGARecord^.NGAArtFileName;
- WorkingFileName := NewsPath + '\' + WorkingFileName;
- TheMemo.Lines.LoadFromFile( WorkingFileName );
- for Counter_1 := 0 to TheMemo.Lines.Count - 1 do
- TheMemo.Lines[ Counter_1 ] := '>' + TheMemo.Lines[ Counter_1 ];
- TheMemo.Lines.Insert( 0 , 'Newsgroups: ' + TheNGRecord^.GRealName );
- TheMemo.Lines.Insert( 1 , 'From: ' );
- TheMemo.Lines.Insert( 2 , 'Subject: ');
- TheMemo.Lines.Insert( 3 , 'Organization: CIUPKC Software' );
- TheMemo.Lines.Insert( 4 , 'Reply-To: ' );
- TheMemo.Lines.Insert( 5 , 'X-Newsreader: CC Internet Command Center' );
- DateString := DateToStr( Date ) + ' ';
- TimeString := TimeToStr( Time );
- TheMemo.Lines.Insert( 6 , 'Date: ' + DateString + TimeString );
- TheMemo.Lines.Insert( 7 , '' );
- Result := true;
- end;
-
- { This method takes all the data in the NewsRCList and if subscribed, CNN's it }
- function TNNTPComponent.CheckAllNewNews : Boolean;
- var Counter_1 : Integer;
- TheNGRecord : PNewsGroupRecord;
- begin
- Result := true;
- for Counter_1 := 0 to TheNewsRCList.Count - 1 do
- begin
- TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] );
- if TheNGRecord^.GSubScribed then Result := CheckForNewNews( TheNGRecord );
- end;
- end;
-
- { This method splits up a listing and pulls out its component data }
- procedure TNNTPComponent.ParseNewsGroupListing( TheListing : String;
- var GroupName : String;
- var LowCurrent : Longint;
- var HighCurrent : Longint;
- var Postable : Boolean );
- var HoldingString ,
- HoldingString2 : String;
- WorkingIndex : Integer;
- begin
- WorkingIndex := Pos( ' ' , TheListing );
- if WorkingIndex = 0 then
- begin
- GroupName := TheListing;
- LowCurrent := -1;
- HighCurrent := -1;
- Postable := false;
- exit;
- end;
- GroupName := Copy( TheListing , 1 , WorkingIndex - 1 );
- HoldingString := Copy( TheListing , WorkingIndex + 1 , 255 );
- WorkingIndex := Pos( ' ' , HoldingString );
- HoldingString2 := Copy( HoldingString , 1 , WorkingIndex - 1 );
- LowCurrent := StrToInt( HoldingString2 );
- HoldingString := Copy( HoldingString , WorkingIndex + 1 , 255 );
- WorkingIndex := Pos( ' ' , HoldingString );
- HoldingString2 := Copy( HoldingString , 1 , WorkingIndex - 1 );
- HighCurrent := StrToInt( HoldingString2 );
- HoldingString := Copy( HoldingString , WorkingIndex + 1 , 255 );
- if (( HoldingString[ 1 ] = 'y' ) or ( HoldingString[ 1 ] = 'Y' )) then
- Postable := true else Postable := false;
- end;
-
- { This is another "Network" command which sets the GROUP to the name of the }
- { imported record. The imported record is also updated to reflect current }
- { available articles. }
- function TNNTPComponent.SetCurrentNewsGroup(
- TheNGRecord : PNewsGroupRecord; DoUpdate : Boolean ) : Boolean;
- var TheReturnString : String; { Internal string holder }
- TheResult : Integer; { Internal int holder }
- TAA , LAA , HAA : Longint;
- begin
- TheReturnString :=
- DoCStyleFormat( 'GROUP %s' ,
- [ TheNGRecord^.GRealName ] );
- { Put result in progress and status line }
- AddProgressText( TheReturnString );
- ShowProgressText( TheReturnString );
- { Begin login sequence with user name }
- TheResult := PerformNNTPCommand( 'GROUP %s',
- [ TheNGRecord^.GRealName ] );
- if TheResult <> TCPIP_STATUS_PRELIMINARY then
- begin
- NNTPCommandInProgress := false;
- Result := false;
- exit;
- end;
- repeat
- TheResult := GetNNTPServerResponse( TheReturnString );
- { Put result in progress and status line }
- AddProgressText( TheReturnString );
- ShowProgressText( TheReturnString );
- until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
- NNTPCommandInProgress := false;
- if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
- begin
- { Do clever C formatting trick }
- TheReturnString :=
- DoCStyleFormat( 'GROUP %s Not Available!' ,
- [ TheNGRecord^.GRealName ] );
- { Put result in progress and status line }
- AddProgressText( TheReturnString );
- ShowProgressErrorText( TheReturnString );
- { Signal error }
- Result := False;
- { leave }
- exit;
- end;
- Result := True;
- { Leave if only want to set group }
- if not DoUpdate then exit;
- { Split out the articles listing into its three numbers }
- ParseArticleListing( TheReturnString , TAA , LAA , HAA );
- { Work on the numbers to make sure display is consistent }
- with TheNGRecord^ do
- begin
- { Set internal pointers }
- GTotalAvailable := TAA;
- GLowestAvailable := LAA;
- GHighestAvailable := HAA;
- if GLowest < GLowestAvailable then
- begin { All stored articles have expired or there are none }
- GTotalNew := GTotalAvailable; { Total new is total available }
- GLowest := GLowestAvailable - 1; { set low and high to below start }
- GHighest := GLowestAvailable - 1; { until something is read }
- end
- else
- begin { Some read articles haven't expired; assume all still good }
- GTotalNew := GHighestAvailable - GHighest; { Total since last download }
- if GTotalNew < 0 then GTotalNew := 0; { Just in case... }
- end;
- end;
- end;
-
- { This method splits out the GROUP response line into TAA, LAA , HAA }
- procedure TNNTPComponent.ParseArticleListing( TheListing : String;
- var TotalAvailable : Longint;
- var LowestAvailable : Longint;
- var HighestAvailable : Longint );
- var WorkingString ,
- WorkingString2 : String;
- WorkingIndex : Integer;
- begin
- WorkingString := Copy( TheListing , 5, 255 );
- WorkingIndex := Pos( ' ' , WorkingString );
- WorkingString2 := Copy( WorkingString , 1 , WorkingIndex - 1 );
- TotalAvailable := StrToInt( WorkingString2 );
- WorkingString := Copy( WorkingString , WorkingIndex + 1 , 255 );
- WorkingIndex := Pos( ' ' , WorkingString );
- WorkingString2 := Copy( WorkingString , 1 , WorkingIndex - 1 );
- LowestAvailable := StrToInt( WorkingString2 );
- WorkingString := Copy( WorkingString , WorkingIndex + 1 , 255 );
- WorkingIndex := Pos( ' ' , WorkingString );
- WorkingString2 := Copy( WorkingString , 1 , WorkingIndex - 1 );
- HighestAvailable := StrToInt( WorkingString2 );
- end;
-
- { This method uses the HEAD command to get a complete article header }
- function TNNTPComponent.GetArticleHeader( TheNumber : Longint;
- TheReturnList : TStringList ) : Boolean;
- var TheReturnString : String; { Internal string holder }
- TheResult : Integer; { Internal int holder }
- HoldPChar ,
- TheReturnPChar ,
- TheHoldingPChar : PChar;
- begin
- TheReturnString :=
- DoCStyleFormat( 'HEAD %d' ,
- [ TheNumber ] );
- { Put result in progress and status line }
- AddProgressText( TheReturnString );
- ShowProgressText( TheReturnString );
- { Begin login sequence with user name }
- TheResult := PerformNNTPCommand( 'HEAD %d', [ TheNumber ] );
- if TheResult <> TCPIP_STATUS_PRELIMINARY then
- begin
- NNTPCommandInProgress := false;
- Result := false;
- exit;
- end;
- repeat
- TheResult := GetNNTPServerResponse( TheReturnString );
- { Put result in progress and status line }
- AddProgressText( TheReturnString );
- ShowProgressText( TheReturnString );
- until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
- NNTPCommandInProgress := false;
- if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
- begin
- { Do clever C formatting trick }
- TheReturnString :=
- DoCStyleFormat( 'Head %d Failed!' ,
- [ TheNumber ] );
- { Put result in progress and status line }
- AddProgressText( TheReturnString );
- ShowProgressErrorText( TheReturnString );
- { Signal error }
- Result := False;
- { leave }
- exit;
- end;
- GetMem( TheReturnPChar , 514 );
- HoldPChar := TheReturnPchar;
- TheReturnList.Clear;
- repeat
- TheResult := GetNNTPServerExtendedResponse( TheReturnPChar );
- if StrLen( TheReturnPChar ) > 255 then
- begin
- Getmem( TheHoldingPChar , 255 );
- while StrLen( TheReturnPChar ) > 255 do
- begin
- StrCopy( TheHoldingPChar , '' );
- StrMove( TheHoldingPChar , TheReturnPChar , 255 );
- TheReturnPChar := TheReturnPChar + 256;
- TheReturnString := StrPas( TheHoldingPChar );
- TheReturnList.Add( TheReturnString );
- end;
- StrCopy( TheHoldingPChar , '' );
- StrMove( TheHoldingPChar , TheReturnPChar , StrLen( TheReturnPChar ));
- TheReturnString := StrPas( TheHoldingPChar );
- TheReturnString := '\' + TheReturnString;
- TheReturnList.Add( TheReturnString );
- FreeMem( TheHoldingPChar , 255 );
- end
- else
- begin
- TheReturnString := StrPas( TheReturnPChar );
- TheReturnList.Add( TheReturnString );
- end;
- until (( GlobalAbortedFlag ) or ( TheResult = TCPIP_STATUS_COMPLETED ));
- FreeMem( HoldPChar , 514 );
- Result := true;
- end;
-
- { This method parses a header stringlist and obtains the subject line }
- function TNNTPComponent.GetHeaderSubject( HList : TStringList ) : String;
- var Counter_1 : Integer;
- Finished : Boolean;
- WorkingIndex : Integer;
- WorkingString : String;
- begin
- Counter_1 := 0;
- Finished := false;
- WorkingString := '[No Subject]';
- while (( not Finished ) and ( Counter_1 < HList.Count - 1 )) do
- begin
- WorkingIndex := Pos( 'SUBJECT:' , Uppercase( HList.Strings[ Counter_1 ] ));
- if WorkingIndex > 0 then
- begin
- WorkingString := Copy( HList.Strings[ Counter_1 ] , 9 , 255 );
- Finished := true;
- end
- else Counter_1 := Counter_1 + 1;
- end;
- Result := WorkingString;
- end;
-
- { This method parses a header stringlist and obtains the sender's ID }
- function TNNTPComponent.GetHeaderSender( HList : TStringList ) : String;
- var Counter_1 : Integer;
- Finished : Boolean;
- WorkingIndex : Integer;
- WorkingString : String;
- begin
- Counter_1 := 0;
- Finished := false;
- WorkingString := '';
- while (( not Finished ) and ( Counter_1 < HList.Count - 1 )) do
- begin
- WorkingIndex := Pos( 'FROM:' , Uppercase( HList.Strings[ Counter_1 ] ));
- if WorkingIndex > 0 then
- begin
- WorkingString := Copy( HList.Strings[ Counter_1 ] , 6 , 255 );
- Finished := true;
- end
- else Counter_1 := Counter_1 + 1;
- end;
- Result := WorkingString;
- end;
-
-
- { This method updates the available headers in the header file for a newsgroup }
- function TNNTPComponent.GetAllArticleHeaders( TheNGRecord : PNewsGroupRecord ) : Boolean;
- var TheNGARecord : PNewsGroupArticleRecord;
- Counter_1 : Integer;
- TheHeaderList : TStringList;
- WorkingList : TList;
- WorkingCounter : Longint;
- begin
- { Do this for ease of coding }
- with TheNGRecord^ do
- begin
- { Get the current TList of article headers }
- WorkingList := TList( GLTag );
- { Set Group Command without updating }
- if not SetCurrentNewsGroup( TheNGRecord , false ) then
- begin
- { Abort if can't get newsgroup }
- Result := false;
- exit;
- end;
- { create the stringlist for header info }
- TheHeaderList := TStringList.Create;
- { Determine how many to get from computed availability }
- WorkingCounter := GHighestAvailable - GTotalNew + 1;
- { Run up to total new articles }
- for Counter_1 := 1 to GTotalNew do
- begin
- { Try to get the header }
- if GetArticleHeader( WorkingCounter , TheHeaderList ) then
- begin
- { If succeed create new header record }
- New( TheNGARecord );
- with TheNGARecord^ do
- begin
- { Fill in all the fields with nominal or acquired data }
- NGAGroupname := GRealName;
- NGASubject := GetHeaderSubject( TheHeaderList );
- NGANumber := WorkingCounter;
- NGADownloaded := false;
- NGASender := GetHeaderSender( TheHeaderList );
- NGARead := false;
- NGAPosted := false;
- NGAArtFileName := '';
- end;
- { Put record on list }
- WorkingList.Add( TheNGARecord );
- end;
- { Either way increment the counter }
- WorkingCounter := WorkingCounter + 1;
- end;
- { Update all the pointer numbers to indicate all article headers gotten }
- GTotalUnreadArticles := GTotalUnreadArticles + GTotalAvailable;
- GTotalArticles := GTotalArticles + GTotalAvailable;
- GTotalAvailable := 0;
- GTotalNew := 0;
- GLowestAvailable := GHighestAvailable;
- GLowest := GLowestAvailable;
- GHighest := GLowestAvailable;
- { Save off the pointer to the modified TList }
- GLTag := Longint( WorkingList );
- { Clean Up and leave }
- Result := true;
- TheHeaderList.Free;
- end;
- end;
-
- { This function deletes all read/sent articles and associated files }
- function TNNTPComponent.PurgeReadSentArticleListings(
- TheNGRecord : PNewsGroupRecord ) : Boolean;
- var TheNGARecord : PNewsGroupArticleRecord;
- Counter_1 : Integer;
- WorkingList : TList;
- Finished : Boolean;
- begin
- { Do this for ease of coding }
- with TheNGRecord^ do
- begin
- { Get the current TList of article headers }
- WorkingList := TList( GLTag );
- { Run up to total new articles }
- for Counter_1 := 0 to WorkingList.Count - 1 do
- begin
- TheNGARecord := PNewsGroupArticleRecord( WorkingList.Items[ Counter_1 ] );
- if ( TheNGARecord^.NGAPosted or TheNGARecord^.NGARead ) then
- begin
- Dec( GTotalArticles );
- if FileExists( NewsPath + '\' + TheNGARecord^.NGAArtFilename ) then
- {DeleteFile( NewsPath + '\' + TheNGARecord^.NGAArtFileName )};
- end;
- end;
- Counter_1 := 0;
- Finished := False;
- while Not Finished do
- begin
- TheNGARecord := PNewsGroupArticleRecord( WorkingList.Items[ Counter_1 ] );
- if ( TheNGARecord^.NGAPosted or TheNGARecord^.NGARead ) then
- begin
- WorkingList.Delete( Counter_1 );
- end
- else Counter_1 := Counter_1 + 1;
- if Counter_1 > WorkingList.Count - 1 then Finished := true;
- end;
- end;
- Result := true;
- end;
-
- { This method uses the ARTICLE command to obtain an article and put it in a }
- { preset/supplied file. It is designed to work by itself or inside DAALs }
- function TNNTPComponent.DownloadArticleListing( TheNumber : Longint;
- TheFileName : String ) : Boolean;
- var TheReturnString : String; { Internal string holder }
- TheResult : Integer; { Internal int holder }
- HoldPChar ,
- TheReturnPChar ,
- TheHoldingPChar : PChar;
- TheArticleFile : TextFile;
- begin
- TheReturnString :=
- DoCStyleFormat( 'ARTICLE %d' ,
- [ TheNumber ] );
- { Put result in progress and status line }
- AddProgressText( TheReturnString );
- ShowProgressText( TheReturnString );
- { Begin login sequence with user name }
- TheResult := PerformNNTPCommand( 'ARTICLE %d', [ TheNumber ] );
- if TheResult <> TCPIP_STATUS_PRELIMINARY then
- begin
- NNTPCommandInProgress := false;
- Result := false;
- exit;
- end;
- repeat
- TheResult := GetNNTPServerResponse( TheReturnString );
- { Put result in progress and status line }
- AddProgressText( TheReturnString );
- ShowProgressText( TheReturnString );
- until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
- NNTPCommandInProgress := false;
- if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
- begin
- { Do clever C formatting trick }
- TheReturnString :=
- DoCStyleFormat( 'Article %d Failed!' ,
- [ TheNumber ] );
- { Put result in progress and status line }
- AddProgressText( TheReturnString );
- ShowProgressErrorText( TheReturnString );
- { Signal error }
- Result := False;
- { leave }
- exit;
- end;
- GetMem( TheReturnPChar , 514 );
- HoldPChar := TheReturnPChar;
- try
- AssignFile( TheArticleFile , TheFileName );
- Rewrite( TheArticleFile );
- except
- MessageDlg( 'Unable to open News Article file ' + TheFileName + '!' ,
- mtError , [mbok],0 );
- Socket1.OutOfBand := 'ABOR'+#13#10;
- repeat
- TheResult := GetNNTPServerResponse( TheReturnString );
- { Put result in progress and status line }
- AddProgressText( TheReturnString );
- ShowProgressText( TheReturnString );
- until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
- result := false;
- exit;
- end;
- repeat
- TheResult := GetNNTPServerExtendedResponse( TheReturnPChar );
- if StrLen( TheReturnPChar ) > 255 then
- begin
- Getmem( TheHoldingPChar , 255 );
- while StrLen( TheReturnPChar ) > 255 do
- begin
- StrCopy( TheHoldingPChar , '' );
- StrMove( TheHoldingPChar , TheReturnPChar , 255 );
- TheReturnPChar := TheReturnPChar + 256;
- TheReturnString := StrPas( TheHoldingPChar );
- Writeln( TheArticleFile , TheReturnString );
- end;
- StrCopy( TheHoldingPChar , '' );
- StrMove( TheHoldingPChar , TheReturnPChar , StrLen( TheReturnPChar ));
- TheReturnString := StrPas( TheHoldingPChar );
- TheReturnString := '\' + TheReturnString;
- Writeln( TheArticleFile , TheReturnString );
- FreeMem( TheHoldingPChar , 255 );
- end
- else
- begin
- TheReturnString := StrPas( TheReturnPChar );
- Writeln( TheArticleFile , TheReturnString );
- end;
- until (( GlobalAbortedFlag ) or ( TheResult = TCPIP_STATUS_COMPLETED ));
- FreeMem( HoldPChar , 514 );
- CloseFile( TheArticleFile );
- Result := true;
- end;
-
- { This method Gets all the Article Listings for a newsgroup which have not been }
- { Downloaded and gets them into text files. It displays Article count, # & bytes }
- { in the status line during the process. }
- function TNNTPComponent.DownloadAllArticleListings( TheNGRecord : PNewsGroupRecord ) : Boolean;
- var WorkingList : TList;
- TheNGARecord : PNewsGroupArticleRecord;
- WorkingGroupNumber,
- WorkingNumber : Longint;
- Counter_1 : Integer;
- WorkingFileName : String;
- begin
- if not SetCurrentNewsGroup( TheNGRecord , false ) then
- begin
- { Abort if can't get newsgroup }
- Result := false;
- exit;
- end;
- with TheNGRecord^ do
- begin
- WorkingGroupNumber := GIDNumber;
- WorkingList := TList( GLTag );
- for Counter_1 := 0 to WorkingList.Count - 1 do
- begin
- TheNGARecord := PNewsGroupArticleRecord( WorkingList.Items[ Counter_1 ] );
- with TheNGARecord^ do
- begin
- if not NGADownloaded then
- begin
- NGADownloaded := true;
- WorkingNumber := NGANumber;
- WorkingFileName := 'AR' + IntToStr( WorkingNumber );
- if Length( WorkingFileName ) > 8 then WorkingFileName :=
- Copy( WorkingFileName , 1 , 8 );
- WorkingFileName := WorkingFileName + '.' +
- IntToStr( WorkingGroupNumber );
- NGAArtFileName := WorkingFileName;
- WorkingFileName := NewsPath + '\' + WorkingFileName;
- DownloadArticleListing( WorkingNumber , WorkingFileName );
- end;
- end;
- end;
- GLTag := Longint( WorkingList );
- Result := true;
- end;
- end;
-
- { This function is similar to the above but uses only marked entries in LB2 }
- function TNNTPComponent.DownloadAllMarkedArticleListings(
- TheNGRecord : PNewsGroupRecord; TheListBox : TListBox ) : Boolean;
- var WorkingString : String;
- WorkingIndex : Integer;
- WorkingList : TList;
- TheNGARecord : PNewsGroupArticleRecord;
- WorkingGroupNumber,
- WorkingNumber : Longint;
- Counter_2 ,
- Counter_1 : Integer;
- WorkingFileName : String;
- begin
- if not SetCurrentNewsGroup( TheNGRecord , false ) then
- begin
- { Abort if can't get newsgroup }
- Result := false;
- exit;
- end;
- with TheNGRecord^ do
- begin
- WorkingIndex := Pos( 'G' , GFileName );
- WorkingString := Copy( GFileName , WorkingIndex + 1 , 255 );
- WorkingIndex := Pos( '.' , WorkingString );
- WorkingString := Copy( WorkingString , 1 , WorkingIndex - 1 );
- WorkingGroupNumber := StrToInt( WorkingString );
- WorkingList := TList( GLTag );
- for Counter_1 := 0 to TheListBox.Items.Count - 1 do
- begin
- if TheListBox.Selected[ Counter_1 ] then
- begin
- WorkingString :=
- TheFTPComponent.StripBrackets( TheListBox.Items[ Counter_1 ] );
- WorkingNumber := StrToInt( WorkingString );
- TheNGARecord := nil;
- for Counter_2 := 0 to WorkingList.Count - 1 do
- begin
- TheNGARecord := PNewsGroupArticleRecord( WorkingList.Items[ Counter_1 ] );
- if TheNGARecord^.NGANumber = WorkingNumber then break;
- end;
- if assigned( TheNGARecord ) then with TheNGARecord^ do
- begin
- if not NGADownloaded then
- begin
- NGADownloaded := true;
- WorkingNumber := NGANumber;
- WorkingFileName := 'AR' + IntToStr( WorkingNumber );
- if Length( WorkingFileName ) > 8 then WorkingFileName :=
- Copy( WorkingFileName , 1 , 8 );
- WorkingFileName := WorkingFileName + '.' +
- IntToStr( WorkingGroupNumber );
- NGAArtFileName := WorkingFileName;
- WorkingFileName := NewsPath + '\' + WorkingFileName;
- DownloadArticleListing( WorkingNumber , WorkingFileName );
- end;
- end;
- end;
- end;
- GLTag := Longint( WorkingList );
- Result := true;
- end;
- end;
-
- { This method posts a previously-created article to a newsgroup via POST }
- function TNNTPComponent.UploadArticleListing(
- TheNGARecord : PNewsGroupArticleRecord ) : Boolean;
- var WorkingString : String;
- WorkingFile : TextFile;
- TheReturnString : String; { Internal string holder }
- TheResult : Integer; { Internal int holder }
- begin
- with TheNGARecord^ do
- begin
- NGAPosted := true;
- NGARead := true;
- WorkingString := NewsPath + '\' + NGAArtFileName;
- try
- AssignFile( WorkingFile , WorkingString );
- Reset( WorkingFile );
- except
- MessageDlg( 'Unable to Post due to open error on '
- + Workingstring + '!' , mtError , [mbok],0 );
- Result := false;
- exit;
- end;
- TheReturnString :=
- DoCStyleFormat( 'POST' ,
- [ nil ] );
- { Put result in progress and status line }
- AddProgressText( TheReturnString );
- ShowProgressText( TheReturnString );
- { Begin login sequence with user name }
- TheResult := PerformNNTPCommand( 'POST', [ nil ] );
- if TheResult <> TCPIP_STATUS_PRELIMINARY then
- begin
- NNTPCommandInProgress := false;
- Result := false;
- exit;
- end;
- repeat
- TheResult := GetNNTPServerResponse( TheReturnString );
- { Put result in progress and status line }
- AddProgressText( TheReturnString );
- ShowProgressText( TheReturnString );
- until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
- repeat
- NNTPCommandInProgress := false;
- ReadLn( WorkingFile , WorkingString );
- TheResult := PerformBlindNNTPCommand( WorkingString );
- if TheResult <> TCPIP_STATUS_PRELIMINARY then
- begin
- NNTPCommandInProgress := false;
- Result := false;
- exit;
- end;
- until EOF( WorkingFile );
- CloseFile( WorkingFile );
- NNTPCommandInProgress := false;
- TheResult := PerformNNTPCommand( '.' , [ nil ] );
- if TheResult <> TCPIP_STATUS_PRELIMINARY then
- begin
- NNTPCommandInProgress := false;
- Result := false;
- exit;
- end;
- repeat
- TheResult := GetNNTPServerResponse( TheReturnString );
- { Put result in progress and status line }
- AddProgressText( TheReturnString );
- ShowProgressText( TheReturnString );
- until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
- Result := true;
- end;
- end;
-
- { This method takes an entire Newsgroup and scans for SENDER = CIUPKC158 and }
- { if that article has not been posted posts it. (Used by queue system.) }
- function TNNTPComponent.UploadAllArticleListings( TheNGRecord : PNewsGroupRecord ) : Boolean;
- var WorkingList : TList;
- Counter_1 : Integer;
- WorkingNGARecord : PNewsGroupArticleRecord;
- begin
- with TheNGRecord^ do
- begin
- WorkingList := TList( GLTag );
- for Counter_1 := 0 to WorkingList.Count - 1 do
- begin
- WorkingNGARecord :=
- PNewsGroupArticleRecord( WorkingList.Items[ Counter_1 ] );
- with WorkingNGARecord^ do
- begin
- if NGASender = 'CIUPKC158' then
- begin
- if not NGAPosted then
- begin
- UploadArticleListing( WorkingNGARecord );
- NGAPosted := true;
- end;
- end;
- end;
- end;
- GLTag := Longint( WorkingList );
- end;
- Result := true;
- end;
-
- { This sends FTP progress text to the Inet form }
- procedure TNNTPComponent.ShowProgressErrorText( WhatText : String );
- begin
- CCInetCCForm.ShowProgressErrorText( WhatText );
- end;
-
- { This is a core function! It performs an FTP command and if no timeout }
- { return a preliminary ok. }
- function TNNTPComponent.PerformNNTPCommand(
- TheCommand : string;
- const TheArguments : array of const ) : Integer;
- var TheBuffer : string; { Text buffer }
- begin
- { If command in progress send back -1 error }
- if NNTPCommandInProgress then
- begin
- Result := -1;
- exit;
- end;
- { Set status variable }
- NNTPCommandInProgress := True;
- { Set global error code }
- GlobalErrorCode := 0;
- { Format output string }
- TheBuffer := Format( TheCommand , TheArguments );
- { Preset failure code }
- Result := TCPIP_STATUS_FATAL_ERROR;
- { If invalid socket or no connection abort }
- if ( Socket1.TheSocket = INVALID_SOCKET ) or not Connection_Established then
- exit;
- { Send the buffer plus EOL chars }
- Socket1.StringData := TheBuffer + #13#10;
- { if abort due to timeout or other error exit }
- if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
- { Otherwise return preliminary code }
- Result := TCPIP_STATUS_PRELIMINARY;
- end;
-
- { This is a core function! It performs an FTP command and if no timeout }
- { return a preliminary ok. }
- function TNNTPComponent.PerformBlindNNTPCommand( TheCommand : string ) : Integer;
- var TheBuffer : string; { Text buffer }
- begin
- { If command in progress send back -1 error }
- if NNTPCommandInProgress then
- begin
- Result := -1;
- exit;
- end;
- { Set status variable }
- NNTPCommandInProgress := True;
- { Set global error code }
- GlobalErrorCode := 0;
- { Format output string }
- TheBuffer := TheCommand;
- { Preset failure code }
- Result := TCPIP_STATUS_FATAL_ERROR;
- { If invalid socket or no connection abort }
- if ( Socket1.TheSocket = INVALID_SOCKET ) or not Connection_Established then
- exit;
- { Send the buffer plus EOL chars }
- Socket1.StringData := TheBuffer + #13#10;
- { if abort due to timeout or other error exit }
- if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
- { Otherwise return preliminary code }
- Result := TCPIP_STATUS_PRELIMINARY;
- end;
-
- { This function gets up to 255 chars of data plus a return code from FTP serv }
- function TNNTPComponent.GetNNTPServerResponse(
- var ResponseString : String ) : integer;
- var
- { Buffer string for response line }
- TheBuffer : string;
- { Pointer to the response string }
- BufferPointer : array[0..255] of char absolute TheBuffer;
- { Character to check for response code }
- ResponseChar : char;
- { Pointers into returned string }
- TheIndex ,
- TheLength : integer;
- { Control variable }
- LeftoversInPan ,
- Finished : Boolean;
- begin
- { Preset fatal error }
- Result := TCPIP_STATUS_FATAL_ERROR;
- { Start loop control }
- LeftoversInPan := false;
- Finished := false;
- repeat
- { Do a peek }
- TheBuffer := Socket1.PeekData;
- { If timeout or other error exit }
- if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
- { Find end of line character }
- TheIndex := Pos( #10 , TheBuffer );
- if TheIndex = 0 then
- begin
- TheIndex := Pos( #13 , TheBuffer );
- if TheIndex = 0 then
- begin
- TheIndex := Pos( #0 , TheBuffer );
- if TheIndex = 0 then
- begin
- TheIndex := Length( TheBuffer );
- LeftoversInPan := True;
- LeftoverText := LeftoverText + TheBuffer;
- LeftoversOnTable := false;
- end;
- end;
- end;
- { If an end of line then process the line }
- if TheIndex > 0 then
- begin
- { Get length of string }
- TheLength := TheIndex;
- { Receive actual data }
- Socket1.CCSockReceive( Socket1.TheSocket ,
- @BufferPointer[ 1 ] ,
- TheLength );
- { Abort if timeout or error }
- if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
- { Put in the length byte }
- BufferPointer[ 0 ] := Chr( TheLength );
- if LeftOversOnTable then
- begin
- LeftOversOnTable := false;
- ResponseString := LeftoverText + TheBuffer;
- TheBuffer := ResponseString;
- LeftoverText := '';
- end;
- if LeftoversInPan then
- begin
- LeftoversInPan := false;
- LeftoversOnTable := true;
- end;
- { Get first number character }
- ResponseChar := TheBuffer[ 1 ];
- { Get the value of the number from 1 to 5 }
- if (( ResponseChar >= '1' ) and ( ResponseChar <= '5' )) then
- begin
- Finished := true;
- Result := Ord( ResponseChar ) - 48;
- end;
- end
- else
- begin
- end;
- until ( Finished and ( not LeftoversOnTable ));
- { Return buffer as response string }
- ResponseString := TheBuffer;
- end;
-
- { Boilerplate error routine }
- procedure TNNTPComponent.NNTPSocketsErrorOccurred( Sender : TObject;
- ErrorCode : Integer;
- TheMessage : String );
- begin
- CCInetCCForm.SocketsErrorOccurred( Sender,ErrorCode,TheMessage );
- end;
-
- { This is the FTP components initial connection routine }
- function TNNTPComponent.EstablishConnection(
- PCRPointer : PConnectionsRecord ) : Boolean;
- var TheReturnString : String; { Internal string holder }
- TheResult : Integer; { Internal int holder }
- begin
- { Set default FTP Port value }
- Socket1.PortName := '119';
- { Get the ip address from the record }
- Socket1.IPAddressName := PCRPointer^.CIPAddress;
- { Set blocking mode }
- Socket1.AsynchMode := False;
- { Clear condition variables }
- GlobalErrorCode := 0;
- GlobalAbortedFlag := false;
- { Actually attempt to connect }
- Socket1.CCSockConnect;
- { Check if connected }
- if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 ) or
- ( Socket1.TheSocket = INVALID_SOCKET )) then
- begin { Didn't connect; signal error and abort }
- { Do clever C formatting trick }
- TheReturnString :=
- DoCStyleFormat( 'NNTP Host %s Connection Failed!' ,
- [ PCRPointer^.CIPAddress ] );
- { Put result in progress and status line }
- AddProgressText( TheReturnString );
- ShowProgressErrorText( TheReturnString );
- { Signal error }
- Result := False;
- { leave }
- exit;
- end
- else
- begin
- Connection_Established := true;
- { Signal successful connection }
- TheReturnString := DoCStyleFormat(
- 'Connected on Local port: %s with IP: %s',
- [ Socket1.GetSocketPort( Socket1.TheSocket ),
- Socket1.GetSocketIPAddress( Socket1.TheSocket )]);
- { Put result in progress and status line }
- CCINetCCForm.AddProgressText( TheReturnString );
- CCINetCCForm.ShowProgressText( TheReturnString );
- TheReturnString := DoCStyleFormat(
- 'Connected to Remote port: %s with IP: %s',
- [ Socket1.GetSocketPeerPort( Socket1.TheSocket ),
- Socket1.GetSocketPeerIPAddress( Socket1.TheSocket )]);
- { Put result in progress and status line }
- CCINetCCForm.AddProgressText( TheReturnString );
- CCINetCCForm.ShowProgressText( TheReturnString );
- TheReturnString := DoCStyleFormat( 'Successfully connected to %s',
- [ Socket1.IPAddressName ]);
- { Put result in progress and status line }
- CCINetCCForm.AddProgressText( TheReturnString );
- CCINetCCForm.ShowProgressText( TheReturnString );
- repeat
- TheResult := GetNNTPServerResponse( TheReturnString );
- { Put result in progress and status line }
- AddProgressText( TheReturnString );
- ShowProgressText( TheReturnString );
- until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
- if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
- begin
- { Do clever C formatting trick }
- TheReturnString :=
- DoCStyleFormat( 'NNTP Host %s Connection Failed!' ,
- [ PCRPointer^.CIPAddress ] );
- { Put result in progress and status line }
- AddProgressText( TheReturnString );
- ShowProgressErrorText( TheReturnString );
- { Signal error }
- Result := False;
- { leave }
- exit;
- end
- else Result := true; { Signal no problem }
- end;
- end;
-
- { This is the FTP component constructor; it creates 2 sockets }
- constructor TNNTPComponent.Create( AOwner : TComponent );
- begin
- { do inherited create }
- inherited Create( AOwner );
- { Create socket, put in their parent, and error procs }
- Socket1 := TCCSocket.Create( Self );
- Socket1.Parent := Self;
- Socket1.OnErrorOccurred := NNTPSocketsErrorOccurred;
- { Set up booleans }
- Connection_Established := false;
- NNTPCommandInProgress := false;
- end;
-
- { This is the FTP component destructor; it frees 2 sockets }
- destructor TNNTPComponent.Destroy;
- begin
- { Free the socket }
- Socket1.Free;
- { and call inherited }
- inherited Destroy;
- end;
-
- procedure TNNTPComponent.UpdateGauge( BytesFinished , TotalToHandle : longint );
- begin
- CCInetCCForm.UpdateGauge( BytesFinished , TotalToHandle );
- end;
-
- { This sends FTP progress text to the Inet form }
- procedure TNNTPComponent.AddProgressText( WhatText : String );
- begin
- CCInetCCForm.AddProgressText( WhatText );
- end;
-
- { This sends FTP progress text to the Inet form }
- procedure TNNTPComponent.ShowProgressText( WhatText : String );
- begin
- CCInetCCForm.ShowProgressText( WhatText );
- end;
-
- { This is the FTP components QUIT routine }
- function TNNTPComponent.Disconnect : Boolean;
- var TheReturnString : String; { Internal string holder }
- TheResult : Integer; { Internal int holder }
- begin
- TheReturnString :=
- DoCStyleFormat( 'QUIT' ,
- [ nil ] );
- { Put result in progress and status line }
- AddProgressText( TheReturnString );
- ShowProgressText( TheReturnString );
- { Begin login sequence with user name }
- PerformNNTPCommand( 'QUIT', [ nil ] );
- repeat
- TheResult := GetNNTPServerResponse( TheReturnString );
- { Put result in progress and status line }
- AddProgressText( TheReturnString );
- ShowProgressText( TheReturnString );
- until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
- NNTPCommandInProgress := false;
- if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
- begin
- { Do clever C formatting trick }
- TheReturnString :=
- DoCStyleFormat( 'NNTP Host Connection Failed!' ,
- [ nil ] );
- { Put result in progress and status line }
- AddProgressText( TheReturnString );
- ShowProgressErrorText( TheReturnString );
- { Signal error }
- Result := False;
- { leave }
- exit;
- end
- else Result := true; { Signal no problem }
- end;
-
- { This is a clever c-style formatting trick }
- function TNNTPComponent.DoCStyleFormat(
- TheText : string;
- const TheArguments : array of const ) : String;
- begin
- Result := Format( TheText , TheArguments ) + #13#10;
- end;
-
-
- end.
-